home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr22 / deleted.zip / D.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-05  |  5KB  |  228 lines
  1. program destroy_;
  2.  
  3. {compiled with Borland Turbo Pascal 7.0 for DOS}
  4.  
  5. {$N-,I-,B+,S+}
  6.  
  7. uses crt,drivers;
  8.  
  9. var
  10. reply : string;
  11. placeholder : char;
  12. destroy : file of byte; { needed only to use the FileSize procedure,
  13.                           which will not work on text files. In case the
  14.                           sensitive file you need to destroy happens to be
  15.                           a text file. }
  16. destroyed : text;
  17. filesize1, filesize2, percentage : real;
  18. count : shortint;
  19. on_off : boolean;
  20.  
  21. label tryagain,done;
  22.  
  23. begin
  24. initsyserror;
  25. tryagain:
  26. count := 0;
  27. reset(input);
  28. textcolor(15);
  29. textbackground(0);
  30. clrscr;
  31. textcolor(13);
  32. textbackground(0);
  33. writeln;
  34. writeln;
  35. textcolor(7);
  36. writeln('  Be sure you want to continue, this program deletes a file forever.');
  37. writeln('  Pathnames are fine if you need to put one. Enter a semicolon to exit.');
  38. writeln('  Wildcards not allowed. You may only destroy one file at a time.');
  39. textcolor(13);
  40. writeln;
  41. writeln;
  42. write('  Name your victim');
  43. textcolor(141);
  44. write(' ───>  ');
  45. textcolor(15);
  46. if not eoln(input) then
  47. begin
  48. donesyserror;
  49. readln (reply);
  50. if reply = ';' then goto done;
  51. assign(destroy, reply);
  52. reset(destroy);
  53. if ioresult <> 0 then
  54. begin
  55. initsyserror;
  56. textcolor(15);
  57. clrscr;
  58. textcolor(12);
  59. reset(input);
  60. gotoxy(2,12);
  61. write('I can''t find or use this file: "');
  62. textcolor(11);
  63. write(reply);
  64. textcolor(12);
  65. writeln('"');
  66. write(' ...maybe it''s read-only. Press Enter... ');
  67. textcolor(15);
  68. if not eoln(input) then
  69. readln(placeholder)
  70. else goto tryagain;
  71. goto tryagain;
  72. end;
  73. end
  74. else goto tryagain;
  75. initsyserror;
  76. filesize1 := filesize(destroy);
  77. filesize2 := 0;
  78. close (destroy);
  79. erase (destroy);
  80. assign (destroyed, reply);  { switch-a-roo the files in the F.A.T. }
  81. rewrite(destroyed);
  82. textcolor(11);
  83. writeln;
  84. writeln;
  85. writeln('  Working... on slower computers and/or larger files this could take a while...');
  86. writeln;
  87. textcolor(14);
  88. textbackground(1);
  89. gotoxy(42,13);
  90. write('      ');
  91. gotoxy(30,13);
  92. write('          ');
  93. gotoxy(30,13);
  94. while filesize2 < filesize1 do
  95. begin
  96. writeln(destroyed, '10101010101010101010101010101 "Yes fan" was here 010101010101010101010101010101');
  97. filesize2 := filesize2 + 81;
  98. percentage := filesize2/filesize1;
  99. while (percentage > 0.1) and (count < 1) do
  100. begin
  101. write('▒');
  102. count := count + 1;
  103. gotoxy(43,13);
  104. write('10% ');
  105. gotoxy(31,13);
  106. end;
  107. while (percentage > 0.2) and (count < 2) do
  108. begin
  109. write('▒');
  110. count := count + 1;
  111. gotoxy(43,13);
  112. write('20% ');
  113. gotoxy(32,13);
  114. end;
  115. while (percentage > 0.3) and (count < 3) do
  116. begin
  117. write('▒');
  118. count := count + 1;
  119. gotoxy(43,13);
  120. write('30% ');
  121. gotoxy(33,13);
  122. end;
  123. while (percentage > 0.4) and (count < 4) do
  124. begin
  125. write('▒');
  126. count := count + 1;
  127. gotoxy(43,13);
  128. write('40% ');
  129. gotoxy(34,13);
  130. end;
  131. while (percentage > 0.5) and (count < 5) do
  132. begin
  133. write('▒');
  134. count := count + 1;
  135. gotoxy(43,13);
  136. write('50% ');
  137. gotoxy(35,13);
  138. end;
  139. while (percentage > 0.6) and (count < 6) do
  140. begin
  141. write('▒');
  142. count := count + 1;
  143. gotoxy(43,13);
  144. write('60% ');
  145. gotoxy(36,13);
  146. end;
  147. while (percentage > 0.7) and (count < 7) do
  148. begin
  149. write('▒');
  150. count := count + 1;
  151. gotoxy(43,13);
  152. write('70% ');
  153. gotoxy(37,13);
  154. end;
  155. while (percentage > 0.8) and (count < 8) do
  156. begin
  157. write('▒');
  158. count := count + 1;
  159. gotoxy(43,13);
  160. write('80% ');
  161. gotoxy(38,13);
  162. end;
  163. while (percentage > 0.9) and (count < 9) do
  164. begin
  165. write('▒');
  166. count := count + 1;
  167. gotoxy(43,13);
  168. write('90% ');
  169. gotoxy(39,13);
  170. end;
  171. end;
  172. write('▒');
  173. gotoxy(43,13);
  174. writeln('100% ');
  175. close (destroyed);
  176. erase (destroyed); { now "reply" is a text file with garbage in it. And it's
  177.                      at least as long as the original, possibly longer by
  178.                      up to 80 bytes. }
  179. writeln;
  180. writeln;
  181. textcolor(14);
  182. textbackground(0);
  183. write('  Done');
  184. textcolor(142);
  185. write('!');
  186. textcolor(14);
  187. write('  Enter a semicolon to quit or press Enter to continue....');
  188. textcolor(15);
  189. textbackground(1);
  190. write('   ');
  191. reset(input);
  192. gotoxy(67,16);
  193. if not eoln(input) then
  194. begin
  195. donesyserror;
  196. readln(placeholder);
  197. if placeholder = ';' then
  198. goto done
  199. else
  200. goto tryagain;
  201. end
  202. else goto tryagain;
  203. done:
  204. textcolor(7);
  205. textbackground(0);
  206. clrscr;
  207. textcolor(11);
  208. writeln;
  209. writeln;
  210. write(' "');
  211. textcolor(9);
  212. write('Yes fan');
  213. textcolor(11);
  214. write('"');
  215. textcolor(9);
  216. writeln(' was here...');
  217. textcolor(13);
  218. writeln;
  219. writeln(' If it works for you, a 2 or 3 dollar contribution would be very welcome...');
  220. textcolor(10);
  221. writeln;
  222. writeln(' Duane Bailey');
  223. writeln(' 409 W. First St, Apt. C');
  224. writeln(' Winston-Salem, NC 27101');
  225. textcolor(7);
  226. writeln;
  227. end.
  228.